home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / tpznewg.zip / ZTEST.PAS < prev   
Pascal/Delphi Source File  |  1990-05-19  |  6KB  |  253 lines
  1. PROGRAM ZTest;
  2.  
  3.   USES Crt,
  4.        SeriellInterface,TransData,Tpz;
  5.  
  6.   VAR
  7.     TimeCounter  : LONGINT ABSOLUTE $40:$6C;
  8.  
  9.     send,
  10.     fehler       : BOOLEAN;
  11.  
  12.     i,
  13.     errnr,
  14.     kanal        : WORD;
  15.  
  16.     zeile,
  17.     fname        : STRING;
  18.  
  19.     taste        : CHAR;
  20.  
  21.     time,
  22.     baudrate,
  23.     transferrate : LONGINT;
  24.  
  25.  
  26. (*************************************************************************)
  27.  
  28. FUNCTION WordToString (wert,stellen : WORD) : STRING;
  29.  
  30.   VAR
  31.     i    : WORD;
  32.  
  33.     line : STRING [10];
  34.  
  35. BEGIN
  36.   Str (wert:stellen,line);
  37.   FOR i:=1 TO Length (line) DO IF (line[i] = ' ') THEN line [i]:='0';
  38.   WordToString:=line;
  39. END;  (* of WordToString *)
  40.  
  41.  
  42. (*************************************************************************)
  43.  
  44. FUNCTION LongIntToString (wert : LONGINT ; stellen : WORD) : STRING;
  45.  
  46.   VAR
  47.     i    : WORD;
  48.  
  49.     line : STRING [10];
  50.  
  51. BEGIN
  52.   Str (wert:stellen,line);
  53.   FOR i:=1 TO Length (line) DO IF (line[i] = ' ') THEN line [i]:='0';
  54.   LongIntToString:=line;
  55. END;  (* of WordToString *)
  56.  
  57.  
  58. (*************************************************************************)
  59.  
  60. {$F+}
  61. PROCEDURE DisplayFileData;
  62.  
  63. BEGIN
  64.   HighVideo;
  65.   GotoXY (20,1);
  66.   Write (TransferName);
  67.  
  68.   CASE FileAddition OF
  69.         NewFile : Write (' (New)');
  70.     ReplaceFile : Write (' (Replace)');
  71.     RecoverFile : Write (' (Recover)');
  72.   END;  (* of CASE *)
  73.  
  74.   ClrEol;
  75.  
  76.   GotoXY (20,3);
  77.   Write (TransferCheck);
  78.   GotoXY (20,4);
  79.   Write (WordToString (TransferTotalTime DIV 60,2));
  80.   Write (':');
  81.   Write (WordToString (TransferTotalTime MOD 60,2));
  82.   GotoXY (20,5);
  83.   Write ('00:00');
  84.   GotoXY (20,6);
  85.   Write (TransferError:5);
  86.   GotoXY (40,5);
  87.   Write (TransferSize:7);
  88.   GotoXY (40,6);
  89.   Write (TransferCount + TransferBytes:7);
  90.   IF (Length (TransferMessage) > 0) THEN BEGIN
  91.     GotoXY (10,8);
  92.     ClrEol;
  93.     Write (TransferMessage);
  94.     TransferMessage:='';
  95.   END;  (* of IF *)
  96.   LowVideo;
  97. END;  (* of DisplayTransferData *)
  98. {$F-}
  99.  
  100.  
  101. (*************************************************************************)
  102.  
  103. {$F+}
  104. PROCEDURE DisplayTransferData;
  105.  
  106.   VAR
  107.     p,
  108.     rate : WORD;
  109.  
  110.     time : LONGINT;
  111.  
  112. BEGIN
  113.   time:=(TimeCounter - TransferTime) DIV 18;
  114.  
  115.   IF (time > 0) THEN
  116.     rate:=WORD (TransferBytes DIV time)
  117.   ELSE rate:=0;
  118.  
  119.   p:=WORD (LONGINT (rate) * 100 DIV LONGINT (transferrate DIV 10));
  120.   IF (p > 9999) THEN p:=9999;
  121.  
  122.   HighVideo;
  123.   GotoXY (20,5);
  124.   Write (WordToString (time DIV 60,2));
  125.   Write (':');
  126.   Write (WordToString (time MOD 60,2));
  127.   GotoXY (20,6);
  128.   Write (TransferError:5);
  129.   GotoXY (42,3);
  130.   Write (TransferBlockSize:5);
  131.   GotoXY (42,4);
  132.   Write (rate:5);
  133.   GotoXY (50,4);
  134.   Write (p:4);
  135.   GotoXY (40,6);
  136.   Write (TransferCount + TransferBytes:7);
  137.   IF (Length (TransferMessage) > 0) THEN BEGIN
  138.     GotoXY (10,8);
  139.     ClrEol;
  140.     Write (TransferMessage);
  141.     TransferMessage:='';
  142.   END;  (* of IF *)
  143.   LowVideo;
  144. END;  (* of DisplayTransferData *)
  145. {$F-}
  146.  
  147.  
  148. (*************************************************************************)
  149.  
  150. BEGIN
  151.   baudrate:=38400;
  152.   MakeCRC32:=FALSE;
  153.   ClrScr;
  154.   InstallSeriellHandler ($3F8,4,2048,kanal);
  155.   IF (kanal <> 0) THEN BEGIN
  156.     SetParameter (kanal,baudrate,None,1,8);
  157.  
  158.     DataTerminalReady (kanal,On);
  159.     RequestToSend (kanal,On);
  160.  
  161.     SetTransmitMask (kanal,RTSOutput);
  162.     SetStatusMask (kanal,CTSInput);
  163.  
  164.     Write ('S)enden  E)mpfangen  ... ');
  165.     REPEAT
  166.       taste:=UpCase (ReadKey);
  167.     UNTIL (taste = 'E') OR (taste = 'S') OR (taste = #27);
  168.  
  169.     IF (taste <> #27) THEN BEGIN
  170.       WriteLn (taste);
  171.       IF (taste = 'S') THEN send:=TRUE ELSE send:=FALSE;
  172.  
  173.       IF send THEN BEGIN
  174.         Write ('Filename ...  ');
  175.         ReadLn (fname);
  176.       END;  (* of IF *)
  177.  
  178.       transferrate:=baudrate;
  179.  
  180.       HighVideo;
  181.       zeile:='';
  182.       FOR i:=1 TO 41 DO zeile:=zeile + '═';
  183.       GotoXY (10,10);
  184.       IF send THEN
  185.         Write ('╔' + zeile + ' Download  ZModem ' + '═╗')
  186.       ELSE Write ('╔' + zeile + ' Upload  ZModem ' + '═══╗');
  187.       GotoXY (10,19);
  188.       Write ('╚' + '═══════════════════' + zeile + '╝');
  189.       FOR i:=1 TO 8 DO BEGIN
  190.         GotoXY (10,10 + i);
  191.         Write ('║');
  192.         GotoXY (71,10 + i);
  193.         Write ('║');
  194.       END;  (* of FOR *)
  195.       zeile:='╟';
  196.       FOR i:=1 TO 60 DO zeile:=zeile + '─';
  197.       zeile:=zeile + '╢';
  198.       GotoXY (10,12);
  199.       Write (zeile);
  200.       GotoXY (10,17);
  201.       Write (zeile);
  202.       LowVideo;
  203.  
  204.       Window (11,11,70,19);
  205.  
  206.       GotoXY (10,1);
  207.       Write ('File .... ');
  208.       IF send THEN BEGIN
  209.         HighVideo;
  210.         Write (fname);
  211.         LowVideo;
  212.       END;  (* of IF *)
  213.       GotoXY (10,3);
  214.       Write ('Check....');
  215.       GotoXY (10,4);
  216.       Write ('Time ....');
  217.       GotoXY (10,5);
  218.       Write ('Time ....');
  219.       GotoXY (10,6);
  220.       Write ('Errors ..');
  221.       GotoXY (30,3);
  222.       Write ('Blk-Size ');
  223.       GotoXY (30,4);
  224.       Write ('CPS .....');
  225.       GotoXY (55,4);
  226.       Write ('%');
  227.       GotoXY (30,5);
  228.       Write ('Size ....');
  229.       GotoXY (30,6);
  230.       Write ('Bytes ...');
  231.  
  232.       IF send THEN BEGIN
  233.         ZmodemSend (fname,transferrate,TRUE,kanal,@DisplayFileData,@DisplayTransferData,errnr);
  234.         fehler:=(errnr = 0);
  235.       END  (* of IF THEN *)
  236.       ELSE ZmodemReceive ('',transferrate,kanal,@DisplayFileData,@DisplayTransferData,fehler);
  237.  
  238.       Window (1,1,80,25);
  239.  
  240.       GotoXY (1,20);
  241.       Write (#7);
  242.  
  243.       taste:=ReadKey;
  244.       IF (taste = #0) AND KeyPressed THEN taste:=ReadKey;
  245.  
  246.       IF NOT (fehler) THEN Write ('Übertragungsfehler');
  247.       WriteLn;
  248.       WriteLn;
  249.     END;  (* of IF *)
  250.     DeInstallSeriellHandler (kanal);
  251.   END  (* of IF THEN *)
  252.   ELSE WriteLn ('8250 nicht gefunden');
  253. END.